FishMarket 1.0/FishMarket v1.0.iso/fishies/501-525/disk_510/atcopy/pc/pccopy.pas

Pascal/Delphi Source File | 1992-05-06 | 5KB | 231 lines

program pccopy;

(*$M 1024, 0, 0 *)
(* Mit $M das Programm speicherresident machen *)
(*$I- *)
(* Durch $I- abschalten der Laufzeitfehler ! *)

(* Version 2.2 13.01.91 *)

uses dos;

var
    flag0,data0,flag,data,name,dprs : word;
    numbuf   : byte;
    len,i,j  : word;
    test     : real;
    vari     : byte;
    fh       : file;
    text     : PathStr;
    DIR      : DirStr;
    oldDIR   : DirStr;
    NAME2    : NameStr;
    EXT      : ExtStr;
    textp    : ^string;


procedure both;
begin
   text  := 'ATCopy2.1';
(* Mit diesem Text ermittle ich die Startaddresse meines Buffers. *)
   data0 := 0;
   for i := 0 to 10000 do
   begin
(* Wenn diese nicht innerhalb der ersten 10000 Bytes liegt => Fehler *)
      textp := ptr(dprs,i);
      if textp^ = text then
      begin
         flag0 := i;
         data0 := flag0 + 24;
(* Es werden 24 Buffer verwendet. Siehe Amiga *)
(* Dies ist mein ERSTES Pascal Programm. Es gibt bestimmt bessere Methoden
   die Schleife abzubrechen, aber es geht ja auch so. *)
         i := 10000;
      end;
   end;
   if data0 = 0 then
   begin
      writeln('Start flag not found !');
      writeln('Program aborted.');
      exit;
   end;

(* Per MEM[a:b] ist ein direkter Speicherzugriff auf die Addresse a:b möglich *)

   MEM[dprs:flag0] := 0;

   flag := flag0;
   data := data0;

(* $10 bedeutet neuer Filename, $50 bedeutet Fehler *)

   repeat
      while MEM[dprs:flag] <> $10 do
      begin
         if MEM[dprs:flag] = $50 then
         begin
            MEM[dprs:flag] := 0;
            writeln('Regular exit !');
            exit;
         end;
      end;

(* Übertragen des Dateinamens. Längenangabe plus Text PASCAL-Format *)

      len := MEM[dprs:data];
      text[0] := char(0);
      for i:= 1 to len do
      begin
         text[i] := char(MEM[dprs:data + i]);
      end;
      text[0] := char(len);

(* Datei öffnen *)

      FSplit(text,DIR,NAME2,EXT);
      if DIR[0] > char(3) then
         dec(DIR[0]);

(* Prüfen, ob das Directory existiert und ggf. erzeugen. *)

      if DIR[2] = char(42) then (* 42 = : *)
      begin
         i := word(DIR[1]);
         j := DiskFree(i-65);
         if j = -1 then
         begin
            writeln ('ERROR: wrong path.');
(* Ungültiges Laufwerk *)
            exit;
         end;
         if j = 0 then
         begin
            writeln('ERROR: disk is full.');
            exit;
         end;
      end;
      GetDir(0,oldDIR);
      ChDir(DIR);
      DOSError := IOResult;
      if DOSError = 3 then
      begin
         MkDir(DIR);
         DOSError := IOResult;
         if DOSError = 3 then
         begin
            writeln('ERROR: disk is write protect.');
            exit;
         end;
      end;
      ChDir(oldDIR);
      DOSError := IOResult;
      MEM[dprs:flag] := 0;

      assign(fh,text);
      rewrite(fh,1);
      DOSError := IOResult;

(* Nächsten der 24 Buffer überprüfen *)

      inc(flag);
      inc(data,$82);
      if flag = data0 then
      begin
         flag := flag0;
         data := data0;
      end;

(* $20 => DatenBlock (nicht letzter) , $30 letzter DatenBlock *)

      repeat
         while (( MEM[dprs:flag] <> $20 ) and ( MEM[dprs:flag] <> $30 ) and ( MEM[dprs:flag] <> $50 )) do ;

(* Diese Schleife ist notwendig, da ich nicht ausschliessen kann, daß beide Rechner
   gleichzeitig ? auf das Dual-Ported-RAM zugreifen. Wenn dies der Fall ist, sind
   die Werte die abgelegt werden nicht eindeutig. Es kam zu recht merkwürdigen Effekten *)

         if MEM[dprs:flag] = $50 then
         begin
            MEM[dprs:flag] := 0;
            writeln('Expecting more data !');
            writeln('Please check the files.');
            close(fh);
            exit;
         end;
         if MEM[dprs:flag] = $20 then
         begin

(* Protokoll der DatenBlöcke:

   Anzahl der Bytes im Block gefolgt von den Daten *)

            i := MEM[dprs:data];
            inc(data);
            blockwrite(fh,MEM[dprs:data],i,j);
            if j <> i then
            begin
               writeln('ERROR: disk is full.');
               close(fh);
               exit;
            end;
            MEM[dprs:flag] := 0;
            inc(flag);
            inc(data,$81);
            if flag = data0 then
            begin
               flag := flag0;
               data := data0;
            end;
         end;
      until MEM[dprs:flag] = $30;
      i := MEM[dprs:data];
      inc(data);
      blockwrite(fh,MEM[dprs:data],i,j);
      if j <> i then
      begin
         writeln('ERROR: disk is full.');
         close(fh);
         exit;
      end;
      MEM[dprs:flag] := 0;
      inc(flag);
      inc(data,$81);
      if flag = data0 then
      begin
         flag := flag0;
         data := data0;
      end;
      close(fh);
   until false;
end;


procedure at;
interrupt;
begin
     dprs := $d000; (* Addresse des Dual-Ported-RAM's PARAMETER Buffer *)
(* Diese Addresse stammt aus dem Buch 'Amiga SYSTEM-Handbuch' von M&T.

   Auch in diesem Buch habe ich einiges über die Janus.library gefunden.
   Insbesondere die Addressen der Buffer. *)

     both;
end;

procedure xt;
interrupt;
begin
     dprs := $f000; (* s.o. Aber für XT bzw. SideCar *)
     both;
end;

(* Mit diesem Trick mache ich das Programm speicherresident. Die Interrupts
   werden von den Programmen XT.exe bzw. AT.exe ausgelöst. Daher wohl auch
   der DeadEND wenn AT.exe alleine aufgerufen wird. *)

begin
     SetIntVec(66,@at);
     SetIntVec(67,@xt);
     keep(0);
end.